home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue31 / bcolorbt / BCOLORBT.ZIP / DFSClrBn.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-06  |  19.7 KB  |  739 lines
  1. {$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }
  2.  
  3. {-----------------------------------------------------------------------------}
  4. { TDFSColorButton v1.80                                                       }
  5. {-----------------------------------------------------------------------------}
  6. { A Windows 95 and NT 4 style color selection button.  It displays a palette  }
  7. { of 20 color for fast selction and a button to bring up the color dialog.    }
  8. { Copyright 1996, Brad Stowers.  All Rights Reserved.                         }
  9. { This component can be freely used and distributed in commercial and private }
  10. { environments, provied this notice is not modified in any way and there is   }
  11. { no charge for it other than nomial handling fees.  Contact me directly for  }
  12. { modifications to this agreement.                                            }
  13. {-----------------------------------------------------------------------------}
  14. { Feel free to contact me if you have any questions, comments or suggestions  }
  15. { at bstowers@pobox.com.                                                      }
  16. { The lateset version will always be available on the web at:                 }
  17. {   http://www.pobox.com/~bstowers/delphi/                                    }
  18. { See ColorBtn.txt for notes, known issues, and revision history.             }
  19. {-----------------------------------------------------------------------------}
  20. { Date last modified:  February 5, 1997                                       }
  21. {-----------------------------------------------------------------------------}
  22.  
  23. unit DFSClrBn;
  24.  
  25. interface
  26.  
  27. {$IFDEF DFS_WIN32}
  28.   {$R DFSClrBn.res}
  29. {$ELSE}
  30.   {$R DFSClrBn.r16}
  31. {$ENDIF}
  32.  
  33. uses
  34.   WinTypes, WinProcs, Messages, Classes, Controls, Forms, Graphics, StdCtrls,
  35.   Buttons, ExtCtrls, CBtnForm;
  36.  
  37. type
  38.   TDFSColorButton = class(TButton)
  39.   private
  40.     FPaletteForm: TDFSColorButtonPalette;
  41.     FSectionName: string;
  42.     FOtherBtnCaption: string;
  43.     FColorsLoaded: boolean;
  44.     FCanvas: TCanvas;
  45.     IsFocused: boolean;
  46.     FStyle: TButtonStyle;
  47.     FColor: TColor;
  48.     FPaletteDisplayed: boolean;
  49.     FPaletteColors: TPaletteColors;
  50.     FOtherColor: TColor;
  51.     FCustomColors: TCustomColors;
  52. {$IFDEF DFS_WIN32}
  53.     FFlat: boolean;
  54.     FCustomColorsKey: string;
  55. {$ELSE}
  56.     FCustomColorsINI: string;
  57. {$ENDIF}
  58.         FOnColorChange: TNotifyEvent;
  59.         FArrowBmp: TBitmap;
  60.     FIsMouseOver: boolean;
  61.  
  62.     procedure CNMeasureItem(var Msg: TWMMeasureItem); message CN_MEASUREITEM;
  63.     procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
  64.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  65.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  66.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  67. {$IFDEF DFS_WIN32}
  68.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  69.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  70. {$ENDIF}
  71.  
  72.     procedure SetStyle(Value: TButtonStyle);
  73.     procedure SetColor(Value: TColor);
  74.     procedure SetPaletteColors(Value: TPaletteColors);
  75.     procedure SetCustomColors(Value: TCustomColors);
  76.     procedure SetArrowBmp(Value: TBitmap);
  77. {$IFDEF DFS_WIN32}
  78.     procedure SetFlat(Value: boolean);
  79. {$ENDIF}
  80.  
  81.     procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
  82.     procedure PaletteSetColor(Sender: TObject; AColor: TColor);
  83.     procedure PaletteClosed(Sender: TObject);
  84.   protected
  85.     procedure CreateParams(var Params: TCreateParams); override;
  86.     procedure CreateWnd; override;
  87.     procedure Loaded; override;
  88.     procedure SetButtonStyle(ADefault: Boolean); override;
  89.     procedure SetDefaultColors; virtual;
  90.  
  91.     function GetSectionName: string; virtual;
  92.     procedure SaveCustomColors; virtual;
  93.     procedure LoadCustomColors; virtual;
  94.   public
  95.     constructor Create(AOwner: TComponent); override;
  96.     destructor Destroy; override;
  97.     procedure Click; override;
  98.         procedure DoColorChange; virtual;
  99.         property ArrowBmp: TBitmap read FArrowBmp write SetArrowBmp;
  100.   published
  101.     property Style: TButtonStyle
  102.        read FStyle
  103.        write SetStyle
  104.        default bsAutoDetect;
  105.     property Color: TColor
  106.        read FColor
  107.        write SetColor
  108.        default clBlack;
  109.     property OtherBtnCaption: string
  110.        read FOtherBtnCaption
  111.        write FOtherBtnCaption;
  112.     property OtherColor: TColor
  113.        read FOtherColor
  114.        write FOtherColor;
  115.     property PaletteColors: TPaletteColors
  116.        read FPaletteColors
  117.        write SetPaletteColors
  118.        stored TRUE;
  119.     property CustomColors: TCustomColors
  120.        read FCustomColors
  121.        write SetCustomColors
  122.        stored TRUE;
  123. {$IFDEF DFS_WIN32}
  124.     property Flat: boolean
  125.        read FFlat
  126.        write SetFlat
  127.        default FALSE;
  128.     property CustomColorsKey: string
  129.        read FCustomColorsKey
  130.        write FCustomColorsKey;
  131. {$ELSE}
  132.     property CustomColorsINI: string
  133.        read FCustomColorsINI
  134.        write FCustomColorsINI;
  135. {$ENDIF}
  136.         property OnColorChange: TNotifyEvent
  137.        read FOnColorChange
  138.        write FOnColorChange;
  139.   end;
  140.  
  141. procedure Register;
  142.  
  143. implementation
  144.  
  145. uses
  146.   ColorAEd, SysUtils,
  147.   {$IFDEF DFS_WIN32}
  148.   Registry,
  149.   {$ELSE}
  150.   IniFiles,
  151.   {$ENDIF}
  152.   DsgnIntf;
  153.  
  154. procedure Register;
  155. begin
  156.   RegisterComponents('Delphi Free Stuff', [TDFSColorButton]);
  157.   RegisterPropertyEditor(TypeInfo(TColorArrayClass), NIL, '',
  158.      TColorArrayProperty);
  159. end;
  160.  
  161.  
  162. constructor TDFSColorButton.Create(AOwner: TComponent);
  163. begin
  164.   inherited Create(AOwner);
  165.   FArrowBmp := TBitmap.Create;
  166.   FArrowBmp.Handle := LoadBitmap(HInstance, 'DFS_ARROW_BMP');
  167.   FPaletteColors := TColorArrayClass.Create(4,5);
  168.   FCustomColors := TColorArrayClass.Create(8,2);
  169.   FPaletteForm := NIL;
  170.   FOtherBtnCaption := '&Other';
  171.   FColorsLoaded := FALSE;
  172.   FCanvas := TCanvas.Create;
  173.   FStyle := bsAutoDetect;
  174.   FColor := clBlack;
  175.   FPaletteDisplayed := FALSE;
  176.   Caption := '';
  177.   FIsMouseOver := FALSE;
  178.   {$IFDEF DFS_DELPHI_3}
  179.   ControlStyle := ControlStyle + [csReflector];
  180.   {$ENDIF}
  181.   {$IFDEF DFS_WIN32}
  182.   FFlat := FALSE;
  183.   FCustomColorsKey := '';
  184.   {$ELSE}
  185.   FCustomColorsINI := '';
  186.   {$ENDIF}
  187.   SetDefaultColors;
  188.   Width := 45;
  189.   Height := 22;
  190. end;
  191.  
  192. destructor TDFSColorButton.Destroy;
  193. begin
  194.   SaveCustomColors;
  195.   FCanvas.Free;
  196.   FPaletteColors.Free;
  197.   FCustomColors.Free;
  198.   FArrowBmp.Free;
  199.   inherited Destroy;
  200. end;
  201.  
  202. procedure TDFSColorButton.CreateWnd;
  203. begin
  204.   inherited CreateWnd;
  205.   
  206.   if not FColorsLoaded then
  207.     LoadCustomColors;
  208. end;
  209.  
  210.  
  211. procedure TDFSColorButton.Loaded;
  212. begin
  213.   inherited Loaded;
  214.   
  215.   LoadCustomColors;
  216. end;
  217.  
  218.  
  219. procedure TDFSColorButton.CreateParams(var Params: TCreateParams);
  220. begin
  221.   inherited CreateParams(Params);
  222.   Params.Style := Params.Style OR BS_OWNERDRAW;
  223. end;
  224.  
  225. procedure TDFSColorButton.SetStyle(Value: TButtonStyle);
  226. begin
  227.   if Value <> FStyle then
  228.   begin
  229.     FStyle := Value;
  230.     Invalidate;
  231.   end;
  232. end;
  233.  
  234. procedure TDFSColorButton.SetColor(Value: TColor);
  235. begin
  236.   if Value <> FColor then
  237.   begin
  238.     FColor := Value;
  239.     Invalidate;
  240.     DoColorChange;
  241.   end;
  242. end;
  243.  
  244. procedure TDFSColorButton.CNMeasureItem(var Msg: TWMMeasureItem);
  245. begin
  246.   with Msg.MeasureItemStruct^ do
  247.   begin
  248.     itemWidth := Width;
  249.     itemHeight := Height;
  250.   end;
  251.   Msg.Result := 1;
  252. end;
  253.  
  254. procedure TDFSColorButton.CNDrawItem(var Msg: TWMDrawItem);
  255. begin
  256.   DrawItem(Msg.DrawItemStruct^);
  257.   Msg.Result := 1;
  258. end;
  259.  
  260. procedure TDFSColorButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
  261. var
  262.   IsDown, IsDefault: Boolean;
  263.   R: TRect;
  264.   Flags: Longint;
  265.   CursorPos: TPoint;
  266.   BtnRect: TRect;
  267. {$IFNDEF DFS_WIN32}
  268.   NewStyle: boolean;
  269.   Bevel: integer;
  270.   TextBounds: TRect;
  271. {$ENDIF}
  272. begin
  273.   FCanvas.Handle := DrawItemStruct.hDC;
  274.   try
  275.     R := ClientRect;
  276.  
  277.     with DrawItemStruct do
  278.     begin
  279.       IsDown := (itemState and ODS_SELECTED <> 0) or (FPaletteDisplayed);
  280.       IsDefault := itemState and ODS_FOCUS <> 0;
  281.     end;
  282.  
  283.     GetCursorPos(CursorPos);
  284.     BtnRect.TopLeft := Parent.ClientToScreen(Point(Left, Top));
  285.     BtnRect.BottomRight := Parent.ClientToScreen(Point(Left + Width,
  286.        Top + Height));
  287.     FIsMouseOver := PtInRect(BtnRect, CursorPos);
  288.  
  289. {$IFDEF DFS_WIN32}
  290.     Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  291.     if IsDown then Flags := Flags or DFCS_PUSHED;
  292.     if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
  293.       Flags := Flags or DFCS_INACTIVE;
  294.     { Don't draw flat if mouse is over it or has the input focus }
  295.     if FFlat and (not FIsMouseOver) and (not Focused) then
  296.       Flags := Flags or DFCS_FLAT;
  297.  
  298.     if IsDown then
  299.     begin
  300.       FCanvas.Pen.Color := clWindowFrame;
  301.       FCanvas.Pen.Width := 1;
  302.       FCanvas.Brush.Style := bsClear;
  303.       FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  304.  
  305.       { DrawFrameControl must draw within this border }
  306.       InflateRect(R, -1, -1);
  307.     end;
  308.  
  309.     { DrawFrameControl does not draw a pressed button correctly }
  310.     if IsDown then
  311.     begin
  312.       FCanvas.Pen.Color := clBtnShadow;
  313.       FCanvas.Pen.Width := 1;
  314.       FCanvas.Brush.Color := clBtnFace;
  315.       FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  316.       InflateRect(R, -1, -1);
  317.     end else begin
  318.       DrawFrameControl(DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
  319.       if (Flags and DFCS_FLAT) <> 0 then
  320.       begin
  321.         { I don't know why, but it insists on drawing this little rectangle }
  322.         InflateRect(R, 2, 2);
  323.         FCanvas.Brush.Color := clBtnFace;
  324.         FCanvas.FrameRect(R);
  325.         InflateRect(R, -2, -2);
  326.       end;
  327.     end;
  328.  
  329.     if IsFocused then
  330.     begin
  331.       R := ClientRect;
  332.       InflateRect(R, -1, -1);
  333.     end;
  334.  
  335.     R := ClientRect;
  336.  
  337.     if IsDown then
  338.       OffsetRect(R, 1, 1);
  339.  
  340.     InflateRect(R, -3, -3);
  341.     if IsFocused and IsDefault then
  342.     begin
  343.       FCanvas.Pen.Color := clWindowFrame;
  344.       FCanvas.Brush.Color := clBtnFace;
  345.       DrawFocusRect(FCanvas.Handle, R);
  346.     end;
  347.  
  348. {$ELSE}
  349.  
  350.     NewStyle := ((Style = bsAutoDetect) and NewStyleControls) or (Style = bsNew);
  351.  
  352.     if NewStyle then Bevel := 1
  353.     else Bevel := 2;
  354.  
  355.     R := DrawButtonFace(FCanvas, ClientRect, Bevel, FStyle, not NewStyle,
  356.       IsDown, IsDefault or IsFocused);
  357.  
  358.     if IsDefault then
  359.     begin
  360.       FCanvas.Brush.Color := clBtnFace;
  361.       TextBounds := R;
  362.       if NewStyle then
  363.       begin
  364.         InflateRect(TextBounds, -2, -2);
  365.         if IsDown then OffsetRect(TextBounds, -1, -1);
  366.       end
  367.       else InflateRect(TextBounds, 1, 1);
  368.       DrawFocusRect(FCanvas.Handle, TextBounds);
  369.     end;
  370.     InflateRect(R, -3, -3);
  371.  
  372. {$ENDIF}
  373.  
  374.     { Draw the color rect }
  375.     InflateRect(R, -2, -1);
  376.     Dec(R.Right, 10);
  377.     FCanvas.Pen.Color := clWindowFrame;
  378.     FCanvas.Pen.Width := 1;
  379.     FCanvas.Brush.Style := bsClear;
  380.     FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  381.     FCanvas.Brush.Color := FColor;
  382.     FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  383.  
  384.     { Draw divider line }
  385.     R.Left := R.Right + 3;
  386.     FCanvas.Pen.Color := clBtnShadow;
  387.     FCanvas.MoveTo(R.Left, R.Top);
  388.     FCanvas.LineTo(R.Left, R.Bottom);
  389.     inc(R.Left);
  390.     FCanvas.Pen.Color := clBtnHighlight;
  391.     FCanvas.MoveTo(R.Left, R.Top);
  392.     FCanvas.LineTo(R.Left, R.Bottom);
  393.  
  394.     { Draw the arrow }
  395.     inc(R.Left, 1);
  396.     inc(R.Top, ((R.Bottom - R.Top) div 2) - (FArrowBmp.Height div 2));
  397.     R.Right := R.Left + FArrowBmp.Width-1;
  398.     R.Bottom := R.Top + FArrowBmp.Height-1;
  399.     FCanvas.Brush.Color := clBtnFace;
  400.     FCanvas.BrushCopy(R, FArrowBmp, Rect(0, 0, FArrowBmp.Width-1,
  401.        FArrowBmp.Height-1), FArrowBmp.Canvas.Pixels[0, FArrowBmp.Height-1]);
  402.   finally
  403.     FCanvas.Handle := 0;
  404.   end;
  405. end;
  406.  
  407. procedure TDFSColorButton.CMFontChanged(var Message: TMessage);
  408. begin
  409.   inherited;
  410.   Invalidate;
  411. end;
  412.  
  413. procedure TDFSColorButton.CMEnabledChanged(var Message: TMessage);
  414. begin
  415.   inherited;
  416.   Invalidate;
  417. end;
  418.  
  419. procedure TDFSColorButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  420. begin
  421.   Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
  422. end;
  423.  
  424. procedure TDFSColorButton.SetButtonStyle(ADefault: Boolean);
  425. begin
  426.   if ADefault <> IsFocused then
  427.   begin
  428.     IsFocused := ADefault;
  429.     Refresh;
  430.   end;
  431. end;
  432.  
  433. procedure TDFSColorButton.Click;
  434. var
  435.   PalXY: TPoint;
  436. {$IFDEF DFS_WIN32}
  437.   ScreenRect: TRect;
  438. {$ENDIF}
  439. begin
  440. {$IFDEF DFS_DELPHI_3}
  441.   Application.NormalizeAllTopMosts;
  442. {$ELSE}
  443.   Application.NormalizeTopMosts;
  444. {$ENDIF}
  445.  
  446.   FPaletteForm := TDFSColorButtonPalette.Create(Self);
  447.   PalXY := Parent.ClientToScreen(Point(Left, Top + Height));
  448. {$IFDEF DFS_WIN32}
  449.   { Screen.Width and Height don't account for non-hidden task bar. }
  450.   SystemParametersInfo(SPI_GETWORKAREA, 0, @ScreenRect, 0);
  451.   if PalXY.Y + 121 > ScreenRect.Bottom then
  452.     { No room to display below the button, show it above instead }
  453.     PalXY := Parent.ClientToScreen(Point(Left, Top - 121));
  454.   if PalXY.X < ScreenRect.Left then
  455.     { No room to display horizontally, shift right }
  456.     PalXY.X := ScreenRect.Left
  457.   else if PalXY.X + 78 > ScreenRect.Right then
  458.     { No room to display horizontally, shift left }
  459.     PalXY.X := ScreenRect.Right - 78;
  460.   FPaletteForm.SetBounds(PalXY.X, PalXY.Y, 78, 121);
  461. {$ELSE}
  462.   if PalXY.Y + 121 > Screen.Height then
  463.     { No room to display below the button, show it above instead }
  464.     PalXY := Parent.ClientToScreen(Point(Left, Top - 121));
  465.   if PalXY.X < 0 then
  466.     { No room to display horizontally, shift right }
  467.     PalXY.X := 0
  468.   else if PalXY.X + 78 > Screen.Width then
  469.     { No room to display horizontally, shift left }
  470.     PalXY.X := Screen.Width - 78;
  471.   FPaletteForm.SetBounds(PalXY.X, PalXY.Y, 78, 121);
  472. {$ENDIF}
  473.   FPaletteForm.btnOther.Caption := OtherBtnCaption;
  474.   FPaletteForm.OtherColor := OtherColor;
  475.   FPaletteForm.Color := Color;
  476.   FPaletteForm.SetParentColor := PaletteSetColor;
  477.   FPaletteForm.PaletteClosed := PaletteClosed;
  478.   FPaletteForm.PaletteColors := PaletteColors;
  479.   FPaletteForm.CustomColors := CustomColors;
  480.   FPaletteDisplayed := TRUE;
  481.   Refresh;
  482.   FPaletteForm.Show;
  483. end;
  484.  
  485. procedure TDFSColorButton.PaletteSetColor(Sender: TObject; AColor: TColor);
  486. begin
  487.   Color := AColor;
  488. end;
  489.  
  490. procedure TDFSColorButton.PaletteClosed(Sender: TObject);
  491. begin
  492.   if FPaletteForm = NIL then exit;
  493.   CustomColors := FPaletteForm.CustomColors;
  494.   FPaletteDisplayed := FALSE;
  495.   Invalidate;
  496.   FPaletteForm := NIL;
  497.   Application.RestoreTopMosts;
  498. end;
  499.  
  500. procedure TDFSColorButton.SetPaletteColors(Value: TPaletteColors);
  501. begin
  502.   FPaletteColors.Assign(Value);
  503. end;
  504.  
  505. procedure TDFSColorButton.SetCustomColors(Value: TCustomColors);
  506. begin
  507.   FCustomColors.Assign(Value);
  508. end;
  509.  
  510.  
  511. function ColorEnumProc(Pen: PLogPen; var Colors: array of TColorRef): integer;
  512.    {$IFDEF DFS_WIN32} stdcall; {$ELSE} export; {$ENDIF}
  513. begin
  514.   if Pen^.lopnStyle = PS_SOLID then
  515.   begin
  516.     if Colors[0] < 20 then
  517.     begin
  518.       inc(Colors[0]);
  519.       Colors[Colors[0]] := Pen^.lopnColor;
  520.       Result := 1;
  521.     end else
  522.       Result := 0;
  523.   end else
  524.     Result := 1;
  525. end;
  526.  
  527.  
  528. procedure TDFSColorButton.SetDefaultColors;
  529. var
  530.   X, Y: integer;
  531.   DefColors: array[0..20] of TColorRef;
  532.   DC: HDC;
  533. begin
  534.   DC := GetDC(GetDesktopWindow);
  535.   try
  536.     if GetDeviceCaps(DC, NUMCOLORS) = 16 then
  537.     begin
  538.       { 16 color mode, enum colors to fill array }
  539.       FillChar(DefColors, SizeOf(DefColors), #0);
  540.       EnumObjects(DC, OBJ_PEN, @ColorEnumProc,
  541.          {$IFDEF DFS_WIN32} LPARAM(@DefColors) {$ELSE} @DefColors {$ENDIF});
  542.       for X := 1 to 4 do
  543.       begin
  544.         for Y := 1 to 5 do
  545.         begin
  546.           PaletteColors[X,Y] := DefColors[(X-1)*5+Y];
  547.         end;
  548.       end;
  549.     end else begin
  550.       { Lots 'o colors, pick the ones we want. }
  551.       PaletteColors[1,1] := RGB(255,255,255);
  552.       PaletteColors[1,2] := RGB(255,0,0);
  553.       PaletteColors[1,3] := RGB(0,255,0);
  554.       PaletteColors[1,4] := RGB(0,0,255);
  555.       PaletteColors[1,5] := RGB(191,215,191);
  556.       PaletteColors[2,1] := RGB(0,0,0);
  557.       PaletteColors[2,2] := RGB(127,0,0);
  558.       PaletteColors[2,3] := RGB(0,127,0);
  559.       PaletteColors[2,4] := RGB(0,0,127);
  560.       PaletteColors[2,5] := RGB(159,191,239);
  561.       PaletteColors[3,1] := RGB(191,191,191);
  562.       PaletteColors[3,2] := RGB(255,255,0);
  563.       PaletteColors[3,3] := RGB(0,255,255);
  564.       PaletteColors[3,4] := RGB(255,0,255);
  565.       PaletteColors[3,5] := RGB(255,247,239);
  566.       PaletteColors[4,1] := RGB(127,127,127);
  567.       PaletteColors[4,2] := RGB(127,127,0);
  568.       PaletteColors[4,3] := RGB(0,127,127);
  569.       PaletteColors[4,4] := RGB(127,0,127);
  570.       PaletteColors[4,5] := RGB(159,159,159);
  571.     end;
  572.   finally
  573.     ReleaseDC(GetDesktopWindow, DC);
  574.   end;
  575.  
  576.   for x := 1 to 8 do
  577.     for y := 1 to 2 do
  578.       CustomColors[x,y] := clWhite;
  579.  
  580.   FOtherColor := clBtnFace;
  581. end;
  582.  
  583.  
  584. function TDFSColorButton.GetSectionName: string;
  585. begin
  586.   Result := Self.Name;
  587.   if Parent <> NIL then
  588.     Result := Parent.Name + '.' + Result;
  589. end;
  590.  
  591.  
  592. procedure TDFSColorButton.SaveCustomColors;
  593. var
  594.   {$IFDEF DFS_WIN32}
  595.   Reg: TRegIniFile;
  596.   {$ELSE}
  597.   Ini: TIniFile;
  598.   {$ENDIF}
  599.   Colors: string;
  600.   x: integer;
  601.   y: integer;
  602. begin
  603.   Colors := '';
  604.   for x := 1 to 8 do
  605.   begin
  606.     for y := 1 to 2 do
  607.     begin
  608.       Colors := Colors + '$' + IntToHex(CustomColors[x,y], 8) + ',';
  609.     end;
  610.   end;
  611.   Delete(Colors, Length(Colors), 1); { strip last comma }
  612.  
  613.   {$IFDEF DFS_WIN32}
  614.   if FCustomColorsKey <> '' then
  615.   begin
  616.     Reg := TRegIniFile.Create(FCustomColorsKey);
  617.     try
  618.       Reg.WriteString('Colors', FSectionName, Colors);
  619.     finally
  620.       Reg.Free;
  621.     end;
  622.   end;
  623.   {$ELSE}
  624.   if FCustomColorsINI <> '' then
  625.   begin
  626.     Ini := TIniFile.Create(FCustomColorsINI);
  627.     try
  628.       Ini.WriteString('Colors', FSectionName, Colors);
  629.     finally
  630.       Ini.Free;
  631.     end;
  632.   end;
  633.   {$ENDIF}
  634. end;
  635.  
  636.  
  637. procedure TDFSColorButton.LoadCustomColors;
  638. var
  639.   {$IFDEF DFS_WIN32}
  640.   Reg: TRegIniFile;
  641.   {$ELSE}
  642.   Ini: TIniFile;
  643.   {$ENDIF}
  644.   Colors: string;
  645.   AColor: string;
  646.   CPos: byte;
  647.   x: integer;
  648.   y: integer;
  649. begin
  650.   Colors := '';
  651.   FSectionName := GetSectionName;
  652.   FColorsLoaded := TRUE;
  653.  
  654.   {$IFDEF DFS_WIN32}
  655.   if FCustomColorsKey <> '' then
  656.   begin
  657.     Reg := TRegIniFile.Create(FCustomColorsKey);
  658.     try
  659.       Colors := Reg.ReadString('Colors', FSectionName, '');
  660.     finally
  661.       Reg.Free;
  662.     end;
  663.   {$ELSE}
  664.   if FCustomColorsINI <> '' then
  665.   begin
  666.     Ini := TIniFile.Create(FCustomColorsINI);
  667.     try
  668.       Colors := Ini.ReadString('Colors', FSectionName, '');
  669.     finally
  670.       Ini.Free;
  671.     end;
  672.   {$ENDIF}
  673.         if Colors <> '' then
  674.         begin
  675.       x := 1;
  676.       y := 1;
  677.       CPos := Pos(',', Colors);
  678.       while CPos > 0 do
  679.       begin
  680.         AColor := Copy(Colors, 1, CPos-1);
  681.         CustomColors[x,y] := StrToIntDef(AColor, clWhite);
  682.         inc(y);
  683.         if y > 2 then
  684.         begin
  685.           y := 1;
  686.           inc(x);
  687.           if x > 8 then
  688.             break;  { all done }
  689.         end;
  690.         Colors := Copy(Colors, CPos+1, Length(Colors));
  691.       end;    { while }
  692.         end;
  693.   end;
  694. end;
  695.  
  696.  
  697. procedure TDFSColorButton.DoColorChange;
  698. begin
  699.   if assigned(FOnColorChange) then
  700.     FOnColorChange(Self);
  701. end;
  702.  
  703. procedure TDFSColorButton.SetArrowBmp(Value: TBitmap);
  704. begin
  705.   if Value <> NIL then
  706.   begin
  707.     FArrowBmp.Assign(Value);
  708.     Invalidate;
  709.   end;
  710. end;
  711.  
  712. {$IFDEF DFS_WIN32}
  713. procedure TDFSColorButton.SetFlat(Value: boolean);
  714. begin
  715.   if Value <> FFlat then
  716.   begin
  717.     FFlat := Value;
  718.     Invalidate;
  719.   end;
  720. end;
  721.  
  722. procedure TDFSColorButton.CMMouseEnter(var Message: TMessage);
  723. begin
  724.   if FFlat and (not FIsMouseOver) then
  725.     Invalidate;
  726. end;
  727.  
  728. procedure TDFSColorButton.CMMouseLeave(var Message: TMessage);
  729. begin
  730.   if FFlat and (FIsMouseOver) then
  731.     Invalidate;
  732. end;
  733. {$ENDIF}
  734.  
  735.  
  736. end.
  737.  
  738.  
  739.